home *** CD-ROM | disk | FTP | other *** search
- Unit FSpeaker; { FIDO unit: Handling of and sound effects for the PC speaker }
- (***************************************************************************
-
- RELEASE 1.04 - as first contained in the file PRUS101.LZH
- by Orazio Czerwenka, 2:2450/540.55, GERMANY
-
- --------------------------------------------
- organized for Fido's PASCAL related echoes
- --------------------------------------------
-
- 06/07/1994 to 07/04/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
- 07/05/1994 to 07/15/1994 by Wolfram Sieber, 2:2453/90.6, GERMANY
- 07/16/1994 to --/--/---- by Orazio Czerwenka, 2:2450/540.55, GERMANY
-
- ====================================================================
-
- Currently there is nobody who is interrested in further supporting
- this unit as the 'unit's current organizer', even though there are
- still some useful routines missing for those who excessivly want
- to use PC speaker sounds in there own programs.
-
- Probably Pawel Ostapczuk will take over this part for future
- releases, but we don't know that definitely by now.
-
- So if you've got yourself any more useful source you wish to
- contribute to this unit or are interessted in becoming its new
- 'current organizer' send your sources or mails to the projects
- 'current' general supervisor:
-
- --------------------------------------------
- Orazio Czerwenka, 2:2450/540.55, GERMANY
- --------------------------------------------
-
- ====================================================================
-
- As far as third party copyrights are not violated this
- source code is hereby placed to the public domain. Use
- it whatever way you want, but use AT YOUR OWN RISK.
-
- In case you should modify the source rather send your
- modifications to the unit's current organizer (see above for
- NM address) than to spread it on your own. This will help to
- keep the unit updated and grant a certain standard to all
- other users as well.
-
- The unit is currently still under work. So it might greatly
- benefit of your participation.
-
- Those who contributed to the following piece of source,
- listed in alphabethical order:
- ================================================================
- Bill Buchanan, Christian Clemens, Orazio Czerwenka, Bjorn
- Felten, Marcus Hardt, Mark Lewis, Max Maischein, Pawel
- Ostapczuk, Peter Schuette, Wolfram Sieber, ...
- ================================================================
- YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
-
- Special thanks to Max Maischein for his kind permission to
- 'exploit' his freeware collection of units 'SUX V. 1.0'.
-
- Credits in your own programs are as welcome as unnecessary.
-
- ***************************************************************************)
-
- {$I FDEFINE.DEF} { use the projects general conditional defines
- and compiler directives ... }
-
- {$R-} { ... and use the unit's specific defines
- afterwards. }
-
- Interface
- Uses
- {$IFDEF CRT}
- CRT
- {$ENDIF}
- {$IFDEF FCRT}
- {$IFDEF CRT} , {$ENDIF}
- FCRT (* for hardware independent delay *)
- {$ENDIF}
- ;
-
- const
- SoundsEnabled : boolean = TRUE; {read/write }
-
- { overloaded CRT routines: }
- procedure nosound; { replaces CRT's nosound }
- procedure sound (hertz : word); { replaces CRT's sound }
-
- { routines to save redunant code: }
- Procedure SoundOff (DelayLen : Word); { Turns the sound off }
- Procedure SoundOn (Note, Tone,
- DelayLen : Word); { Turns the sound on }
-
- { parameterless routines: }
- Procedure Alarm; { Gives an alarming sound }
- Procedure Beep; { Makes a beep }
- Procedure Bell; { Bright sound }
- procedure Bell2; { 9 * BipSound }
- procedure Bip; { 1050 Hz, 30 ms }
- Procedure Boop; { Makes a boop }
- procedure Bop; { 50 Hz, 30 ms }
- Procedure BuzzSaw; { Makes a buzzsawing sound }
- procedure Car;
- procedure ClecClac;
- Procedure CloseWhistle;
- Procedure ErrorBeep; { Another 'deep' sounding error beep }
- procedure Explosion;
- procedure Explosion2;
- Procedure Falling;
- procedure Falling2;
- Procedure Fanfare; { The FroDo BeBiBoop }
- procedure Flak;
- procedure Gun;
- Procedure HiRing; { simulates a phone's 'high' ringing }
- procedure Laser;
- Procedure LoRing; { simulates a phone's 'low' ringing }
- Procedure MorseCode; { Makes some senseless morse code }
- procedure MP;
- procedure Mystic;
- procedure Mystic2;
- procedure Mystic3;
- procedure Mystic4;
- procedure Mystic5;
- procedure Noname1;
- procedure Noname2;
- procedure Noname3;
- procedure Noname4;
- procedure Noname5;
- procedure Noname6;
- procedure Nuke;
- Procedure OpenWhistle;
- procedure Rain;
- procedure RandomSound;
- procedure SinusBeep;
- procedure StartingCar;
- Procedure TootTootToot; {3 times: 444 Hz, 34 ms
- 0 Hz, 34 ms}
- Procedure Warning;
- Procedure WindowsBeep; { A rather crude windows - wrong -
- key pressed - sound }
- Procedure WrongSequence; { plays the 1st octave with swapped
- 'g' and 'a' }
- Procedure Zip1; { Makes a sound like ZZZZip }
- Procedure Zip2; { Makes a sound like ZZZZiiip }
-
- { routines with parameters: }
- Procedure Beam (Heigth : Word); { Makes a 'beam' sound }
- procedure Ploing (step : byte); { Makes a sawing noise. }
- Procedure Zap (Key : Word); { Makes a sound like ZZZZaaap }
-
- {----------------------------------------------------------------------------}
-
- Implementation
-
- {-overloaded CRT routines--------------------------------------------------1-}
-
- procedure nosound; assembler;
- {turns the speaker off}
- { Original author: Mark Lewis }
- asm
- IN AL,61h
- AND AL,0FCh
- OUT 61h,AL
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure sound (hertz : word); Assembler;
- {hertz is the sound frequency to send to the speaker port}
- { Original author: Mark Lewis }
- asm
- MOV BX,SP
- MOV BX,&hertz
- MOV AX,34DDh
- MOV DX,0012h
- CMP DX,BX
- JNB @J1
- DIV BX
- MOV BX,AX
- IN AL,61h
- TEST AL,03h
- JNZ @J2
- OR AL,03h
- OUT 61h,AL
- MOV AL,-4Ah
- OUT 43h,AL
- @J2:
- MOV AL,BL
- OUT 42h,AL
- MOV AL,BH
- OUT 42h,AL
- @J1:
- end;
-
- {-overloaded CRT routines--------------------------------------------------9-}
-
- {-routines to save redunant code-------------------------------------------1-}
-
- Procedure SoundOff ( DelayLen : Word );
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Begin
- NoSound;
- If NOT SoundsEnabled then exit;
- Delay( DelayLen );
- End;
-
- { -------------------------------------------------------------------------- }
-
- Procedure SoundOn ( Note, Tone, DelayLen : Word );
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Begin
- If NOT SoundsEnabled then exit;
-
- Sound( Note*Tone SHR 1 );
- Delay( DelayLen );
- End;
-
- {-routines to save redunant code-------------------------------------------9-}
-
- {-sound effects------------------------------------------------------------1-}
-
- Procedure Alarm;
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Var I : Byte;
- Begin
- If NOT SoundsEnabled then exit;
-
- For I := 1 To 3 Do
- Begin
- SoundOn ( 1000,2,300 );
- SoundOn ( 500,1,300 );
- End;
- NoSound;
- End;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Beam ( Heigth : Word );
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Var I : Word;
- Begin
- If NOT SoundsEnabled then exit;
-
- For I := 1 To Heigth Do
- Begin
- SoundOn ( I * 10, 1, 5 );
- SoundOff (5);
- End;
- For I := Heigth DownTo 1 Do
- Begin
- SoundOn ( I * 10, 1, 5 );
- SoundOff (5);
- End;
- End;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Beep;
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Begin
- If NOT SoundsEnabled then exit;
-
- SoundOn (440,2,100);
- NoSound;
- End;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Bell;
- { Original author: Max Maischein }
- Begin
- If NOT SoundsEnabled then exit;
-
- SoundOn (660,1,100);
- NoSound;
- End;
-
- { -------------------------------------------------------------------------- }
-
- procedure Bell2;
- {Original author: Wolfram Sieber}
- const
- BellDelay = 30;
- var
- i : byte;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=1 to 9 do begin
- Bip;
- SoundOff (BellDelay)
- end
- END;
-
- { -------------------------------------------------------------------------- }
-
- procedure Bip;
- {Original author: Wolfram Sieber}
- begin
- If NOT SoundsEnabled then exit;
-
- SoundOn (1050, 1, 30);
- NoSound;
- END;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Boop;
- { Original author: Max Maischein }
- Begin
- If NOT SoundsEnabled then exit;
-
- SoundOn (220,2,100);
- NoSound;
- End;
-
- { -------------------------------------------------------------------------- }
-
- procedure Bop;
- {Original author: Wolfram Sieber}
- begin
- If NOT SoundsEnabled then exit;
-
- SoundOn (50, 1, 30);
- NoSound;
- END;
-
- { -------------------------------------------------------------------------- }
-
- Procedure BuzzSaw;
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Var I : Word;
- Begin
- If NOT SoundsEnabled then exit;
-
- For I := 500 DownTo 1 Do
- Begin
- SoundOn ( I * 10, 1, 5 );
- SoundOff (5);
- End;
- End;
-
- { -------------------------------------------------------------------------- }
-
- procedure Car;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=10 to 540 do
- SoundOn (round(1000*sin(i * 1 div 2)), 1, 1);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure ClecClac;
- {Original author: Wolfram Sieber}
- const
- Clec = 250;
- Clac = 200;
- begin
- If NOT SoundsEnabled then exit;
-
- SoundOff (1); SoundOn (Clec, 1, 55);
- SoundOff (1); SoundOn (Clac, 1, 55);
- NoSound;
- END;
-
- { -------------------------------------------------------------------------- }
-
- Procedure CloseWhistle;
- { Original author: Bill Buchanan
- Modified by Wolfram Sieber }
- Var
- Frequency: Integer;
- begin
- If SoundsEnabled then
- For Frequency := 1000 downto 500 do
- begin
- Delay(1);
- Sound(Frequency)
- end;
- NoSound
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure ErrorBeep;
- { Original author: Peter Schuette }
- Begin
- If NOT SoundsEnabled then exit;
-
- SoundOn(50,1,500);
- NoSound;
- End;
-
- { -------------------------------------------------------------------------- }
-
- procedure Explosion;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i: integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=10 to 240 do
- SoundOn (round(500*sin(i * 1)), 1, 1);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Explosion2;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i: integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=1000 downto 200 do
- SoundOn(random(i+100), 1, 2);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Falling;
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Var I : Word;
- Begin
- If NOT SoundsEnabled then exit;
-
- For I := 50 DownTo 20 Do
- Begin
- SoundOn ( I * 10, 3, 50 );
- SoundOff ( 20 );
- End;
- End;
-
- { -------------------------------------------------------------------------- }
-
- procedure Falling2;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i: integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=3000 downto 650 do
- SoundOn (i, 1, 1);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Fanfare;
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Begin
- If NOT SoundsEnabled then exit;
-
- Bell;
- Beep;
- Boop;
- End;
-
- { -------------------------------------------------------------------------- }
-
- procedure flak;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- delay(100);
- for i:=10 to 550 do
- SoundOn (round(1000*sin(i * 2)), 1, 1);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Gun;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:= 250 to 400 do
- SoundOn (random(4000-10*i)-50, 1, 1);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure HiRing;
- { Original author: Bjorn Felten,
- modifications Orazio Czerwenka,
- modification by Wolfram Sieber }
- var i:word;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=0 to 6 do
- begin
- soundon(523,2,50);
- soundon(659,2,50);
- end;
- nosound
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Laser;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:= 0 to 500 do begin
- Sound (random(5500-10*i)-50); {SoundOn is too slow}
- Delay (1); {to be used in this case}
- end;
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure LoRing;
- { Original author: Bjorn Felten,
- modifications Orazio Czerwenka,
- modification by Wolfram Sieber }
- var i:word;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=0 to 6 do
- begin
- soundon(523,1,50);
- soundon(659,1,50);
- end;
- nosound
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure MorseCode;
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Var I : Word;
- Begin
- If NOT SoundsEnabled then exit;
-
- For I := 1 To 10 Do
- Begin
- SoundOn ( 600, 2, 100 );
- SoundOff ( 30 + Random (200) );
- End;
- End;
-
- { -------------------------------------------------------------------------- }
-
- procedure MP;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:= 250 to 290 do
- SoundOn (random(10*i)-60, 1, 1);
- nosound;
- delay(10);
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Mystic;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:= 800 to 2000 do
- SoundOn (random(3*5000-4*10*i)-50, 1, 3);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Mystic2;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:= 800 to 2000 do begin
- SoundOn (random(3*5000-4*10*i)-50, 1, 2);
- SoundOn (5500-(i), 1, 1);
- end;
- nosound;
- delay(50);
- {for i:=10 to 250 do begin
- SoundOn (random(500+i*2)+500, 1, 2);
- end;}
-
- for i:=1000*2 downto 200*2 do
- SoundOn (random(i div (2+ i div 10000) +100), 1, 2);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Mystic3;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i,x: Integer;
- begin
- If NOT SoundsEnabled then exit;
-
- i:=30;
- x:=30;
- repeat
- SoundOn (i, 1, 1);
- SoundOn (x, 1, 2);
- inc(i,2);
- inc(x,4);
- until (x>5000) {or (keypressed)};
- Nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Mystic4;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i,x: Integer;
- begin
- If NOT SoundsEnabled then exit;
-
- i:=30;
- x:=30;
- repeat
- SoundOn (i, 1, 1); Nosound;
- SoundOn (x, 1, 2); Nosound;
- inc(i,2);
- inc(x,4);
- until (x>5000) {or (keypressed)};
- Nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Mystic5;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i: integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=500 to 2700 do
- SoundOn (random(1000)+2*i-500, 1, 1);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Noname1;
- {Original author: Wolfram Sieber}
- var
- i : word;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=1 to 17 do begin
- SoundOn (i*100, 1, 13);
- NoSound;
- SoundOn (1500, 1, 13);
- NoSound;
- end;
- END;
-
- { -------------------------------------------------------------------------- }
-
- procedure Noname2;
- {Original author: Wolfram Sieber}
- var
- i : word;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=200 to 2500 do begin
- SoundOn (500, 1, 1);
- NoSound;
- SoundOn (i, 1, 1);
- end;
- nosound
- END;
-
- { -------------------------------------------------------------------------- }
-
- procedure Noname3;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=0 to 1000 do
- SoundOn(i*i, 1, 1);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Noname4;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=0 to 1000 do
- SoundOn (i mod 100, 1, 1);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Noname5;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i,a:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=0 to 10 do begin
- a:=a+500;
- SoundOn (a, 1, 10);
- end;
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Noname6;
- { Original author: Christian Clemens
- Modified by Wolfram Sieber }
- var i,c : byte;
- hz : word;
- begin
- If NOT SoundsEnabled then exit;
-
- for c:=1 to 3 do
- for i:=1 to 100 do
- begin
- hz := i*180+100;
- SoundOn ( hz, 1, 5);
- nosound;
- end;
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Nuke;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:= 0 to 5000 do begin
- nosound;
- SoundOn (random(50+i)-50, 1, 3);
- end;
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- Procedure OpenWhistle;
- { Original author: Bill Buchanan
- Modified by Wolfram Sieber }
- Var
- Frequency : Integer;
- begin
- If NOT SoundsEnabled then exit;
-
- For Frequency := 500 to 1000 do
- begin
- Delay(1);
- Sound(Frequency)
- end;
- NoSound
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure Ploing (step : byte);
- {Original author: Wolfram Sieber}
- var {Fine "Step"s: 10..2}
- i : byte;
- begin
- If NOT SoundsEnabled then exit;
-
- For i:=1 to 100 do begin
- SoundOn (i*10, 1, Step);
- NoSound;
- end;
- END;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Rain;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- begin
- If NOT SoundsEnabled then exit;
-
- SoundOn (Random(30)+20, 1, 3);
- SoundOff (Random(200));
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure RandomSound;
- {Original author: Wolfram Sieber}
- var
- i : byte;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=1 to 24 do begin
- SoundOn ((random (3)+1)*222, 1, 10);
- SoundOff (75);
- end
- END;
-
- { -------------------------------------------------------------------------- }
-
- procedure SinusBeep;
- { Original author: Pawel Ostapczuk
- Modified by Wolfram Sieber }
- var i:integer;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:= 0 to 5 do
- SoundOn (round(2000*sin(1000*i))-100, 1, 20);
- nosound;
- end;
-
- { -------------------------------------------------------------------------- }
-
- procedure StartingCar;
- {Original author: Wolfram Sieber}
- var
- i : byte;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=30 to 120 do begin
- SoundOn (i, 1, 50);
- nosound
- end;
- END;
-
- { -------------------------------------------------------------------------- }
-
- procedure TootTootToot;
- {Original author: Wolfram Sieber}
- const
- TootDelay = 34;
- var
- i : byte;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=1 to 3 do begin
- SoundOn (444, 1, TootDelay);
- SoundOff (TootDelay)
- end
- END;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Warning;
- { Original author: Christian Clemens
- Modified by Wolfram Sieber }
- Var X : Byte;
- Begin
- If NOT SoundsEnabled then exit;
-
- For X := 1 To 3 Do
- Begin
- Sound ( 125 ); Delay ( 50 ); NoSound;
- Delay ( 25 );
- End;
- End;
-
- { -------------------------------------------------------------------------- }
-
- Procedure WindowsBeep;
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- Begin
- If NOT SoundsEnabled then exit;
-
- SoundOn( 860,2,30 );
- SoundOn( 660,2,15 );
- NoSound;
- End;
-
- { -------------------------------------------------------------------------- }
-
- procedure WrongSequence;
- {Original author: Wolfram Sieber}
- var
- Note : byte;
- Octave : array [1..7] of byte;
- begin
- If NOT SoundsEnabled then exit;
-
- Octave [1] := 131; {instead of normally 130.81 Hz}
- Octave [2] := 147; {instead of normally 146.83 Hz}
- Octave [3] := 165; {instead of normally 164.81 Hz}
- Octave [4] := 175; {instead of normally 174.61 Hz}
- Octave [6] := 196;
- Octave [5] := 220;
- Octave [7] := 247; {instead of normally 246.94 Hz}
- for Note := 1 to 7 do begin
- SoundOn (round (Octave [Note]), 1, 50);
- SoundOff (30);
- end;
- END;
-
- { -------------------------------------------------------------------------- }
-
- Procedure Zap( Key : Word );
- { Original author: Max Maischein
- Modified by Wolfram Sieber }
- VAR I,J,K,L : Word;
- Begin
- If NOT SoundsEnabled then exit;
-
- For I := 1 To 11 Do
- Begin
- J := 1 * 23 + ( 51 - Random ( Key ) );
- For K := 1 To 5 Do
- Begin
- For L := 1 To 37 - K * 2 Do Sound ( ( L+J+K*2)*3 Div 2 );
- Delay ( Key );
- Inc ( J , 31 );
- End;
- End;
- NoSound ;
- End;
-
- { -------------------------------------------------------------------------- }
-
- procedure Zip1;
- {Original author: Wolfram Sieber}
- var
- i : byte;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=1 to 150 do
- SoundOn (i*100, 1, 1);
- nosound
- END;
-
- { -------------------------------------------------------------------------- }
-
- procedure Zip2;
- {Original author: Wolfram Sieber}
- var
- i : byte;
- begin
- If NOT SoundsEnabled then exit;
-
- for i:=1 to 150 do begin
- SoundOn (i*100, 1, 1);
- nosound;
- end;
- END;
-
- {-sound effects------------------------------------------------------------9-}
-
- (* procedure InitFSPEAKER;
- begin
- EnableSpeaker;
- end;
-
- {$IFOPT O-}
- Begin
- InitFSPEAKER;
- {$ENDIF} *)
- End.
-
-